home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / comm / fido / SHELTER275.lha / rexx / FTNsort.rexx < prev    next >
OS/2 REXX Batch file  |  1995-04-17  |  10KB  |  322 lines
  1. /**/
  2. v="$VER: FTNsort Rexx Multi-FTN Extract and Sort Williamson 50.32"
  3. import_mode="DIR"   /* or PKT */
  4. Import_Packet=""
  5. import_Dir=""
  6. prodfile='CFG:ftscprod.069'
  7. /* define your AmigaDOS script here with fullpath name. This will be    */
  8. /* executed as: 'Run >NIL: Execute' Import_Packet domain pktfile       */
  9. /* Your script key arguments should be:                                 */
  10. /*  .key domain/a,file/a                                                */
  11. /*      where domain is the FTN organization name of the file           */
  12. /*      and file is the name of the file                                */
  13. /* your script should be able to build the fullpathname                 */
  14. /* If no command is specified, CYBERCRON will asyncronously execute     */ 
  15. /* InboundMGR.rexx                                                      */
  16. /*
  17.      Some HUBS bundle mail for all ones' addresses in a single archive
  18.      If you know this is case for your HUB, then you can use this utility
  19.      to extract the packets from the archive and sort them by ftn,
  20.      moving them to the proper inbound directory.
  21.      It may also be necessary to use this, after EMSI sessions, if your 
  22.      tosser is not domain or zone aware.
  23.      Written for Guy Smith ;)
  24. */
  25. debug=0
  26. options results
  27. options failat 20
  28. signal on syntax
  29. signal on halt
  30. signal on ioerr
  31. signal on break_c
  32. signal on break_d
  33.  
  34. if ~show("L", "rexxsupport.library") then
  35.     if ~addlib("rexxsupport.library", 0, -30, 0) then do
  36.         PutLog("Couldn't access rexxsupport.library !",100,10)
  37.         exit 20
  38.     end
  39. if ~show("L", "rexxdossupport.library") then
  40.     if ~addlib("rexxdossupport.library", 0, -30, 2) then do
  41.         PutLog("Couldn't access rexxdossupport.library !",100,10)
  42.         exit 20
  43.     end
  44. pragma("W","NULL")
  45. log=show('P','ROOFLOG')
  46. sv="v"||right(v,5)
  47. script="FTNsort"
  48. dolist=0;impdir=0
  49.  
  50. rpath=GetClip('REXXDIR')||"/"
  51. dl=GetClip('DOMAINLIST')
  52. inroot=GetCLIP('INDIR')"/"
  53. mback=GetClip('BACKUPDIR')"/"
  54. call makedir(inroot||"ftnsort")
  55. sortdir=inroot||"ftnsort/"
  56. tfile="T:FTNS-"Pragma('ID')
  57. ImportDirList=""
  58. parse upper arg arcmail indir .
  59. if (~openport('CMPORT')) then do
  60.   call PutLog('Another task has CMPORT',40,90)
  61.   if exists('RPDIR:FTNSORT') then  address "CYBERCRON" "ADD_EVENT" '* * * * * :NAME Sort Run >NIL: FTNSORT 'arcmail indir' :EXECONCE :OBEYQUEUE i'
  62.   else address "CYBERCRON" "ADD_EVENT" '* * * * * :NAME Sort :REXX 'rpath'FTNsort.rexx 'arcmail indir' :EXECONCE :OBEYQUEUE i'
  63.   exit 0
  64. end
  65. if arcmail="" then do
  66.   call PutLog('No file name, exiting',10,10)
  67.   exit 0
  68. end
  69. if arcmail="LIST" then do
  70.   sortlist=indir
  71.   if ~exists(sortlist) then do
  72.     putlog(sortlist' does not exist',10,10)
  73.     exit
  74.   end
  75.   arcmail=""
  76.   indir=""
  77.   dolist=1
  78. end;else if arcmail="SCAN" then do
  79.   sortlist="T:scan"||pragma('ID')
  80.   lspec="????????.(PK|MO|TU|WE|TH|FR|SA|SU)[T,0-9]"
  81.   cmd='List >'sortlist addslash(indir)||lspec 'nohead LFORMAT "%S%S"'         
  82.   PutLog('Scanning: 'indir,10,90)
  83.   address COMMAND cmd
  84.   arcmail=""
  85.   dolist=1
  86. end
  87.  
  88. if debug then wspec='CON:0/10/640/100/'script sv'/WAIT/AUTO/SCREEN'||GetClip('ASYNCSCREEN')
  89. else wspec='CON:0/10/640/100/'script sv'/INACTIVE/AUTO/SCREEN'||GetClip('ASYNCSCREEN')
  90. call close('STDOUT');call open('STDOUT',wspec,'w')
  91. call close('STDIN');call open('STDIN','*','R')
  92.  
  93. if dolist=0 then call sortarc()
  94. else do
  95.   call putLog('Sorting mail list' sortlist,10,10)
  96.   x=open('list',sortlist,'r') 
  97.   if x=0 then do
  98.     call PutLog('Cannot find 'sortlist,10,10)
  99.     exit
  100.   end
  101.   do while ~eof('list')
  102.     arcmail=readln('list')
  103.     if arcmail="" then iterate
  104.     if exists(arcmail) then call sortarc()
  105.     else call PutLog(arcmail' does not exist',10,10)
  106.   end
  107.   call close('list')
  108.   call delete(sortlist)
  109. end
  110. if import_mode="DIR" & strip(ImportDirList)~="" then do
  111.   do i=1 to words(ImportDirList) by 2
  112.     destdir=word(ImportDirList,i)
  113.     domain=word(ImportDirList,i+1)
  114.     PutLog('Requesting import of 'DOMAIN' directory:'destdir,10,10)
  115.     if Import_Packet="" then do
  116.       Address CYBERCRON 'ADD_EVENT * * * * * :REXX Ram:rexx/InboundMGR.rexx TOSSPKT 'domain' :EXECONCE :OBEYQUEUE i'
  117.     end;else do
  118.       Address COMMAND "Run >NIL: Execute" Import_Packet destdir
  119.     end
  120.   end
  121. end
  122. exit
  123.  
  124. sortarc:
  125. if indir="" | indir="INDIR" then do
  126.   if index(arcmail,":")>0 | index(arcmail,"/")>0 then do
  127.     indir=get_path(arcmail)
  128.     arcmail=get_fn(arcmail)
  129.   end;else do
  130.     indir=inroot||"NONSECURE/"
  131.   end
  132. end;else do
  133.   indir=addslash(indir)
  134.   arcmail=get_fn(arcmail)
  135. end
  136. call Pragma('D',sortdir)
  137. fnote=subword(statef(indir||arcmail),8)
  138.  
  139. PutLog('Processing:'indir||arcmail fnote,10,10)
  140.  
  141. if right(upper(arcmail),4)='.PKT' then do
  142.   ispacket=1
  143.   PutLog('Moving 'arcmail' to 'sortdir,10,10)
  144.   if ~rename(indir||arcmail,sortdir||arcmail) then do
  145.     PutLog('Move 'indir||arcmail' to 'sortdir||arcmail' failed',10,10)
  146.     return
  147.   end
  148. end;else do
  149.   ispacket=0
  150.   if ~MatchPattern("????????.(MO|TU|WE|TH|FR|SA|SU)[0-9]",arcmail,'N') then do
  151.     PutLog(indir||arcmail' is not valid ARCmail',10,10)
  152.     return 
  153.   end
  154.   if exists('RPDIR:X') then address COMMAND "X" indir||arcmail "*.PKT"
  155.   else address "REXX" rpath'X.rexx' indir||arcmail
  156.   if RC ~= 0 then do
  157.     PutLog('Extract of 'indir||arcmail' failed',10,10)
  158.     return
  159.   end
  160. end
  161. /* get list of packets */
  162. pktlist=showdir(sortdir,"F")
  163. if words(pktlist)=0 then do
  164.   PutLog('Found no packets in' sortdir,10,10)
  165.   return
  166. end;else do
  167.   PutLog('Found mail packets in' sortdir,10,10)
  168.   err=0
  169.   /* examine each packet */
  170.   do i=1 to words(pktlist)
  171.     moveit=0
  172.     pktfile=word(pktlist,i)
  173.     pktmail=sortdir||pktfile
  174.     if word(statef(pktmail),2) ~= '0' then do
  175.       domain=readpkt(pktmail)
  176.       if domain=0 then err=err+1
  177.       else do
  178.         destdir=addslash(inroot||domain)
  179.         moveit=1
  180.       end
  181.     end
  182.     if ~moveit then iterate
  183.     if ~rename(pktmail,destdir||pktfile) then do
  184.       call PutLog('Rename of 'pktmail 'to' destdir||pktfile' failed',10,10)
  185.       err=err+1
  186.     end;else do
  187.       Address COMMAND "FileNote" destdir||pktfile '"'fnote'"'
  188.  
  189.       if import_mode="PKT" then do
  190.          PutLog('Requesting import of 'destdir||pktfile,10,10)
  191.         if Import_Packet="" then do
  192.           Address CYBERCRON 'ADD_EVENT * * * * * :REXX Ram:rexx/InboundMGR.rexx TOSSPKT 'domain pktfile' :EXECONCE :OBEYQUEUE i'
  193.         end;else do
  194.           Address COMMAND "Run >NIL: Execute" Import_Packet domain pktfile
  195.         end
  196.       end;else do
  197.         impdir=1
  198.         if pos(destdir,ImportDirList)=0 then ImportDirList=ImportDirList" "destdir" "domain" "
  199.       end
  200.     end
  201.   end
  202. end
  203. if ispacket=0 then do
  204.   if err=0 then do
  205.     PutLog('Deleting 'indir||arcmail,10,10)
  206.     call delete(indir||arcmail)
  207.   end;else do
  208.     PutLog('Had 'err' errors, renaming 'indir||arcmail' to 'indir||arcmail||'.BAD',10,10)
  209.     call rename(indir||arcmail,indir||arcmail||'.BAD')
  210.    end
  211. end
  212. return 0
  213.  
  214.  
  215. /* read a packet and get destination address and domain */
  216. readpkt:
  217. packet=arg(1)
  218. if ~open('pkt',packet,'R') then do
  219.   PutLog("Can't open "packet,10,10)
  220.   err=err+1
  221.   return 0
  222. end
  223. buffer=readch('pkt',58)
  224. call close('pkt')
  225.  
  226. ozone=getint(46)
  227. if ozone=0 | ozone=256 then ozone=getint(34)
  228. dzone=Getint(48)
  229. if dzone=0 | dzone=256 then dzone=getint(36)
  230.  
  231. if ozone=0 | ozone=256 | dzone=0 | dzone=256 then do
  232.   PutLog("ERR: Can't find domain, zone undefined in "packet,10,10)
  233.   err=err+1
  234.   drop buffer packet
  235.   return 0
  236. end
  237. oaddress=ozone":"getint(20)"/"getint(0)"."getint(50)
  238. daddress=dzone":"getint(22)"/"getint(2)"."getint(52)
  239. PutLog('Packet 'packet' from 'oaddress' for 'daddress,10,10)
  240.  
  241. odomain=find_domain(ozone)
  242. ddomain=find_domain(dzone)
  243. PutLog('Origin Domain:'odomain', Destination Domain:'ddomain,10,10)
  244. pch=GetByte(42)
  245. pcl=GetByte(24)
  246. pc=right("0000"||d2x(pcl),4)  
  247. pver='v'||GetByte(25)'.'GetByte(43)
  248. drop buffer packet
  249. found=0
  250. if open('pf',prodfile,'r') then do
  251.   do while ~eof('pf')
  252.     q=readln('pf')
  253.     if left(q,length(pc))=pc then do
  254.       found=1
  255.       parse var q qa ',' name ',' qa ',' type ',' qa ',' qa
  256.       leave
  257.     end
  258.   end
  259.   call close('pf')
  260. end
  261. if found then call PutLog('Product:'name '('pc')' type pver' from 'oaddress,10,10)
  262. else call PutLog('Product:'pch pcl '('pc')' pver' from 'oaddress,10,10)
  263. return ddomain
  264.  
  265. getint:   return c2d('00'x||reverse(substr(buffer,arg(1)+1,2)))
  266. getint2:  return right('00'||c2d('00'x||reverse(substr(buffer,arg(1)+1,2))),2)
  267. getbyte:  return c2d('00'x||substr(buffer,arg(1)+1,1)) 
  268.  
  269. PutLog:  procedure expose log script
  270.   if arg(3) < GetClip('STATUSLEVEL') then say arg(1)
  271.   if arg(2) > GetClip('LOGLEVEL') then return 0
  272.   if log then address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  273. return 0
  274.  
  275. cleanup:
  276.   PutLog('Exiting',10,10)
  277.   if exists(tfile) then call delete(tfile)
  278. return 0
  279.  
  280.  
  281. addslash:
  282. curr=arg(1)
  283. select
  284.   when right(curr, 1)=":" then nop
  285.   when right(curr, 1)="/" then nop
  286.   otherwise curr=curr"/"
  287. end
  288. return(curr)
  289.  
  290. get_path:
  291. pos=LastPos('/',arg(1))
  292. if pos=0 then pos=LastPos(':',arg(1))
  293. return SubStr(arg(1),1,pos)
  294.  
  295. get_fn:
  296. if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
  297. else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
  298. else return arg(1)
  299.  
  300. /*  Error handling */
  301. break_c:
  302. break_d:
  303.     call cleanup
  304.     exit 10
  305. novalue: call template_oops "Novalue" sigl
  306. syntax:  call template_oops "Syntax(RC="||RC||")" sigl RC
  307. failure: call template_oops "Failure(RC="||RC||")" sigl
  308. ioerr:   call template_oops "IOErr" sigl 
  309. halt:    call template_oops "Halt" sigl 
  310. template_oops: procedure
  311.     parse arg what badline code
  312.     if code ~= "" then call PutLog("ERR: Line" badline what errortext(code),10,10)
  313.     else call PutLog("ERR: Line "badline what,10,10)
  314.     call cleanup
  315.     exit(40)
  316. /**/
  317.  
  318. find_domain: procedure expose dl
  319. dz=FIND(dl,arg(1))
  320. if dz=0 then return 0
  321. else return strip(word(dl,dz-1))
  322.